home *** CD-ROM | disk | FTP | other *** search
/ PCMania 64 / PCMania CD64_1.iso / pcmania / demo64 / water.pas < prev   
Pascal/Delphi Source File  |  1997-12-22  |  3KB  |  93 lines
  1.  
  2. { HEY! PcManíacos:                                               }
  3.  
  4. { Si queréis contactar con los autores de esta sección,          }
  5. { ahora podéis hacerlo a través de sus e-mails privados:         }
  6.  
  7. { Miquel Barceló: (Demoscene)                                    }
  8. {                               e-mail: sa281@blues.uab.es       }
  9.  
  10. { Eduard Sánchez Palazón (Curso de ficheros musicales/Demoscene) }
  11. {                               e-mail: eduard@ergos.es          }
  12.  
  13. { Esperamos vuestros mensajes!                                   }
  14.  
  15. { -------------------------------------------------------------- }
  16. {  Efectos Recursivos / water.pas                                }
  17. {  Por Miquel Barceló                                            }
  18. { -------------------------------------------------------------- }
  19.  
  20. uses crt,graf;
  21.  
  22. procedure Prepara_Paleta;
  23. var
  24.    cont  : integer;
  25.    r,g,b : byte;
  26. begin
  27.      for cont:=0 to 125 do
  28.          putrgb(cont,30*cont div 125,35*cont div 125,50*cont div 125);
  29.      for cont:=126 to 255 do
  30.          putrgb(cont,30+33*(cont-125) div 130,35+28*(cont-125) div 130,50+13*(cont-125) div 130);
  31. end;
  32.  
  33. procedure Agua (desde,hasta : pointer);
  34. var
  35.    cont           : word;
  36.    s1,o1,s2,o2    : word;
  37.    temp           : integer;
  38. begin
  39.      s1:=seg(desde^);
  40.      o1:=ofs(desde^);
  41.      s2:=seg(hasta^);
  42.      o2:=ofs(hasta^);
  43.      for cont:=320 to 63680 do
  44.      begin
  45.           temp:=mem[s1:o1+cont-320]+
  46.                 mem[s1:o1+cont-1]+
  47.                 mem[s1:o1+cont+1]+
  48.                 mem[s1:o1+cont+320]
  49.                 -512;
  50.           temp:=temp shr 1 - mem[s2:o2+cont]+128;
  51.           mem[s2:o2+cont]:=128+temp-temp shr 7;
  52.      end;
  53. end;
  54.  
  55. var
  56.    pant  :array [0..1] of pointer;
  57.    c     :integer;
  58.    cnt   : integer;
  59. begin
  60.      getmem(pant[0],64000);
  61.      getmem(pant[1],64000);
  62.      cls(128,pant[0]^);
  63.      cls(128,pant[1]^);
  64.      Set_Vga;
  65.      Prepara_Paleta;
  66.      c:=0;
  67.      repeat
  68.            Agua(pant[c],pant[c xor 1]);
  69.            c:=c xor 1;
  70.            flip(pant[c]^,vga^);
  71.            mem[seg(pant[c]^):ofs(pant[c]^)+320+random(63360)]:=255;
  72.            mem[seg(pant[c]^):ofs(pant[c]^)+320+random(63360)]:=255;
  73.            mem[seg(pant[c]^):ofs(pant[c]^)+320+random(63360)]:=255;
  74.      until keypressed;
  75.      readkey;
  76.      repeat
  77.            Agua(pant[c],pant[c xor 1]);
  78.            c:=c xor 1;
  79.            flip(pant[c]^,vga^);
  80.            mem[seg(pant[c]^):ofs(pant[c]^)+32160+round(80*sin(cnt/15))+320*round(80*sin(cnt/21))]:=250;
  81.            cnt:=cnt+1;
  82.      until keypressed;
  83.      readkey;
  84.      repeat
  85.            Agua(pant[c],pant[c xor 1]);
  86.            c:=c xor 1;
  87.            flip(pant[c]^,vga^);
  88.      until keypressed;
  89.      Set_Text;
  90.      freemem(pant[0],64000);
  91.      freemem(pant[1],64000);
  92. end.
  93.